home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / pctecap.arc / WINDOW.PAS < prev   
Pascal/Delphi Source File  |  1986-03-15  |  3KB  |  124 lines
  1. { Turbo Pascal removable window system }
  2. { Copyright 1984 Michael A. Covington  }
  3.  
  4. { Requirements: IBM PC or close compatible.   }
  5. { Screen must be in text mode, on page 1,     }
  6. { either mono or color card.                  }
  7.  
  8. { Call INITWIN before calling MKWIN or RMWIN. }
  9.  
  10. const maxwin = 5;  { maximum number of windows open at once }
  11.  
  12. type imagetype  = array [1..4096] of char;
  13.      windimtype = record
  14.                     x1,y1,x2,y2: integer
  15.                   end;
  16. var
  17.   win: { Global variable package }
  18.     record
  19.       dim:    windimtype;  { Current window dimensions }
  20.       depth:  integer;
  21.       stack:  array[1..maxwin] of
  22.                 record
  23.                   image: imagetype;  { Saved screen image }
  24.                   dim:   windimtype; { Saved window dimensions }
  25.                   x,y:   integer     { Saved cursor position }
  26.                 end
  27.     end;
  28.  
  29.   crtmode:      byte      absolute $0040:$0049;
  30.   crtwidth:     byte      absolute $0040:$004A;
  31.   monobuffer:   imagetype absolute $B000:$0000;
  32.   colorbuffer:  imagetype absolute $B800:$0000;
  33.  
  34. procedure initwin;
  35.   { Records initial window dimensions }
  36. begin
  37.   with win.dim do
  38.     begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
  39.   win.depth:=0
  40. end;
  41.  
  42. procedure boxwin(x1,y1,x2,y2:integer);
  43.   { Draws a box, fills it with blanks, and makes it the current }
  44.   { window.  Dimensions given are for the box; actual window is }
  45.   { one unit smaller in each direction.                         }
  46.   { This routine can be used separately from the rest of the    }
  47.   { removable window package.                                   }
  48. var x,y: integer;
  49. begin
  50.   window(1,1,80,25);
  51.  
  52.   { Top }
  53.   gotoxy(x1,y1);
  54.   write(chr(213));
  55.   for x:=x1+1 to x2-1 do write(chr(205));
  56.   write(chr(184));
  57.  
  58.   { Sides }
  59.   for y:=y1+1 to y2-1 do
  60.     begin
  61.       gotoxy(x1,y);
  62.       write(chr(179), ' ':x2-x1-1, chr(179))
  63.     end;
  64.  
  65.   { Bottom }
  66.   gotoxy(x1,y2);
  67.   write(chr(212));
  68.   for x:=x1+1 to x2-1 do write(chr(205));
  69.   write(chr(190));
  70.  
  71.   { Make it the current window }
  72.   window(x1+1,y1+1,x2-1,y2-1);
  73.   gotoxy(1,1)
  74. end;
  75.  
  76. procedure mkwin(x1,y1,x2,y2:integer);
  77.   { Create a removable window }
  78.  
  79. begin
  80.   { Increment stack pointer }
  81.   with win do depth:=depth+1;
  82.   if win.depth>maxwin then
  83.     begin
  84.       writeln(^G,' Windows nested too deep ');
  85.       halt
  86.     end;
  87.  
  88.   { Save contents of screen }
  89.   if crtmode = 7 then
  90.     win.stack[win.depth].image := monobuffer
  91.   else
  92.     win.stack[win.depth].image := colorbuffer;
  93.  
  94.   win.stack[win.depth].dim := win.dim;
  95.   win.stack[win.depth].x   := wherex;
  96.   win.stack[win.depth].y   := wherey;
  97.  
  98.   { Create the window }
  99.   boxwin(x1,y1,x2,y2);
  100.   win.dim.x1 := x1+1;
  101.   win.dim.y1 := y1+1;    { Allow for margins }
  102.   win.dim.x2 := x2-1;
  103.   win.dim.y2 := y2-1;
  104.  
  105. end;
  106.  
  107. procedure rmwin;
  108.   { Remove the most recently created removable window }
  109.   { Restore screen contents, window dimensions, and   }
  110.   { position of cursor.  }
  111. begin
  112.   if crtmode = 7 then
  113.     monobuffer := win.stack[win.depth].image
  114.   else
  115.     colorbuffer := win.stack[win.depth].image;
  116.   with win do
  117.     begin
  118.       dim := stack[depth].dim;
  119.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  120.       gotoxy(stack[depth].x,stack[depth].y);
  121.       depth := depth - 1
  122.     end
  123. end;
  124.